home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / fortran / ftnchk26.zip / SOURCE / PRSYMTAB.C < prev    next >
C/C++ Source or Header  |  1992-09-19  |  49KB  |  1,839 lines
  1. /* prsymtab.c:
  2.  
  3.         Routines associated with printing of symbol table info
  4.  
  5.     Copyright (C) 1992 by Robert K. Moniot.
  6.     This program is free software.  Permission is granted to
  7.     modify it and/or redistribute it, retaining this notice.
  8.     No guarantees accompany this software.
  9.  
  10.     Shared functions defined:
  11.  
  12.         arg_array_cmp()   Compares subprogram calls with defns.
  13.         check_arglists()  Scans global symbol table for subprograms
  14.                   and finds subprogram defn if it exists.
  15.         check_comlists()  Scans global symbol table for common blocks.
  16.         com_cmp_strict()      Compares lists of common variables.
  17.         debug_symtabs()    Prints debugging info about symbol tables.
  18.         print_loc_symbols(curmodhash) Prints local symtab info.
  19.  
  20.     Private functions defined:
  21.         check_mixed_common() checks common for nonportable mixed type
  22.         sort_symbols()      Sorts the list of names of a given category.
  23.         swap_symptrs()      Swaps a pair of pointers.
  24.         check_flags()     Outputs messages about used-before-set etc.
  25.         print_symbols(sym_list,n,do_types) Prints symbol lists.
  26.         print_variables(sym_list,n)  Prints variable symbol table
  27. */
  28.  
  29. #include <stdio.h>
  30. #include <ctype.h>
  31. #include <string.h>
  32. #include "ftnchek.h"
  33. #include "symtab.h"
  34.  
  35.  
  36. PRIVATE int
  37. has_nonalnum();
  38.  
  39. PRIVATE unsigned
  40. find_sixclashes(), print_variables(), print_symbols();
  41.  
  42.  
  43. PRIVATE void
  44. swap_symptrs(), sort_symbols(), check_flags(), check_mixed_common(),
  45. com_cmp_lax(),com_cmp_strict(), arg_array_cmp(),
  46. print_tokenlist(), visit_child(), sort_child_list();
  47.  
  48.             /* Shorthand for check control settings */
  49. #define check_array_dims (array_arg_check&01) /* levels 1 and 3 */
  50. #define check_array_size (array_arg_check&02) /* levels 2 and 3 */
  51. #define check_set_used    (usage_check&01) /* levels 1 and 3 */
  52. #define check_unused    (usage_check&02) /* levels 2 and 3 */
  53.  
  54. #define pluralize(n) ((n)==1? "":"s")    /* singular/plural suffix for n */
  55.  
  56. #define CMP_ERR_LIMIT 3    /* stop printing errors after this many */
  57.  
  58. PRIVATE void
  59. arg_array_cmp(name,args1,args2)
  60.              /* Compares subprogram calls with definition */
  61.     char *name;
  62.     ArgListHeader *args1, *args2;
  63. {
  64.     int i,
  65.         typerr = 0,
  66.         usage_err = 0;
  67.     int  n,
  68.          n1 = args1->numargs,
  69.          n2 = args2->numargs;
  70.     ArgListElement *a1 = args1->arg_array,
  71.                *a2 = args2->arg_array;
  72.  
  73.     n = (n1 > n2) ? n2: n1;        /* n = min(n1,n2) */
  74.  
  75.     if (n1 != n2){
  76.     fprintf(list_fd,"\nSubprogram %s: varying number of arguments:",name);
  77.     fprintf(list_fd,"\n\t%s with %d argument%s in module %s line %u file %s",
  78.             args1->is_defn? "Defined":"Invoked",
  79.                 n1,pluralize(n1),
  80.             args1->module->name,
  81.             args1->line_num,
  82.             args1->filename);
  83.  
  84.     fprintf(list_fd,"\n\t%s with %d argument%s in module %s line %u file %s",
  85.             args2->is_defn? "Defined":"Invoked",
  86.             n2,pluralize(n2),
  87.             args2->module->name,
  88.             args2->line_num,
  89.             args2->filename);
  90.         }
  91.  
  92.     {    /* Look for type mismatches */
  93.         typerr = 0;
  94.         for (i=0; i<n; i++) {
  95.         if(a1[i].type != a2[i].type){
  96.             int t1 = datatype_of(a1[i].type),
  97.             t2 = datatype_of(a2[i].type);
  98.  
  99.             /* Allow hollerith to match integer or logical */
  100.             if( (t1 == type_HOLLERITH
  101.                && (t2 == type_INTEGER || t2 == type_LOGICAL))
  102.              || (t2 == type_HOLLERITH
  103.                && (t1 == type_INTEGER || t1 == type_LOGICAL))
  104.        && (storage_class_of(a1[i].type)==storage_class_of(a1[i].type)) )
  105.                   continue;
  106.  
  107.             /* stop after limit: probably a cascade */
  108.             if(++typerr > CMP_ERR_LIMIT) {
  109.                 fprintf(list_fd,"\n etc...");
  110.                 break;
  111.             }
  112.  
  113.             if(typerr == 1)
  114.     fprintf(list_fd,"\nSubprogram %s:  argument data type mismatch",
  115.                  name);
  116.  
  117.     fprintf(list_fd, "\n  at position %d:", i+1);
  118.     fprintf(list_fd,"\n\t%s %s %s in module %s line %u file %s",
  119.                 args1->is_defn? "Dummy type": "Actual type",
  120.                 type_name[t1],
  121.                 class_name[storage_class_of(a1[i].type)],
  122.                 args1->module->name,
  123.                 args1->line_num,
  124.                 args1->filename);
  125.     fprintf(list_fd,"\n\t%s %s %s in module %s line %u file %s",
  126.                 args2->is_defn? "Dummy type": "Actual type",
  127.                 type_name[t2],
  128.                 class_name[storage_class_of(a2[i].type)],
  129.                 args2->module->name,
  130.                 args2->line_num,
  131.                 args2->filename);
  132.             if(args1->is_defn
  133.             && storage_class_of(a1[i].type) == class_SUBPROGRAM
  134.             && storage_class_of(a2[i].type) != class_SUBPROGRAM
  135.             && datatype_of(a1[i].type) != type_SUBROUTINE
  136.             && ! a1[i].declared_external )
  137.    fprintf(list_fd,"\n\t(possibly it is an array which was not declared)");
  138.         }
  139.         }
  140.     }/* end look for type mismatches */
  141.  
  142.  
  143.          /* Check arrayness of args only if defn exists */
  144.     if( args1->is_defn ) {
  145.         int arrayness_errs = 0;
  146.         unsigned long diminfo1,diminfo2,dims1,dims2,size1,size2;
  147.  
  148.         for (i=0; i<n; i++) {
  149.           if(storage_class_of(a1[i].type) == class_VAR
  150.           && storage_class_of(a2[i].type) == class_VAR) {
  151.  
  152.             /* Allow holleriths to match arrays.  Type
  153.                match was checked above, so they will
  154.                be matching arrays of integer or logical. */
  155.             if( datatype_of(a1[i].type) == type_HOLLERITH
  156.              || datatype_of(a2[i].type) == type_HOLLERITH )
  157.                   continue;
  158.  
  159.         diminfo1 = a1[i].info.array_dim;
  160.         diminfo2 = a2[i].info.array_dim;
  161.         dims1 = array_dims(diminfo1);
  162.         dims2 = array_dims(diminfo2);
  163.         size1 = array_size(diminfo1);
  164.         size2 = array_size(diminfo2);
  165. #if DEBUG_PRSYMTAB
  166. if(debug_latest){
  167. fprintf(list_fd,"\n%s arg %d: array_var=%d%d array_element=%d%d",
  168. name,i+1,
  169. a1[i].array_var,a2[i].array_var,
  170. a1[i].array_element,a2[i].array_element);
  171. fprintf(list_fd,"\nDummy dims=%ld size=%ld",dims1,size1);
  172. fprintf(list_fd,"\nActual dims=%ld size=%ld",dims2,size2);
  173. }
  174. #endif
  175.  
  176.         if( a1[i].array_var ) {    /* I. Dummy arg is array */
  177.             if( a2[i].array_var ) {
  178.             if( a2[i].array_element ) {
  179.                     /*   A. Actual arg is array elt */
  180.                     /*    Warn on check_array_dims. */
  181.                 if(check_array_dims) {
  182.                 /* stop after limit: probably a cascade */
  183.                 if(++arrayness_errs > CMP_ERR_LIMIT) {
  184.                       fprintf(list_fd,"\n etc...");
  185.                       break;
  186.                 }
  187.  
  188.                 if(arrayness_errs == 1)
  189.  fprintf(list_fd,"\nSubprogram %s:  argument arrayness mismatch",
  190.                  name);
  191.  
  192.  fprintf(list_fd, "\n  at position %d:", i+1);
  193.  
  194.  fprintf(list_fd,
  195.     "\n\tDummy arg is whole array in module %s line %u file %s",
  196.                 args1->module->name,
  197.                 args1->line_num,
  198.                 args1->filename);
  199.  fprintf(list_fd,
  200.     "\n\tActual arg is array element in module %s line %u file %s",
  201.                 args2->module->name,
  202.                 args2->line_num,
  203.                 args2->filename);
  204.                 }
  205.             }
  206.             else {
  207.                     /*   B. Actual arg is whole array */
  208.                     /*    Warn if dims or sizes differ */
  209.  
  210.             /* size = 0 or 1 means adjustable: OK to differ */
  211.                 if( (check_array_size &&
  212.                   (size1 > 1 && size2 > 1 && size1 != size2))
  213.                  || (check_array_dims &&
  214.                   (dims1 != dims2)) ) {
  215.  
  216.                 /* stop after limit: probably a cascade */
  217.                 if(++arrayness_errs > CMP_ERR_LIMIT) {
  218.                       fprintf(list_fd,"\n etc...");
  219.                       break;
  220.                 }
  221.  
  222.                 if(arrayness_errs == 1)
  223.  fprintf(list_fd,"\nSubprogram %s:  argument arrayness mismatch",
  224.                  name);
  225.  
  226.  fprintf(list_fd, "\n  at position %d:", i+1);
  227.  
  228.  fprintf(list_fd,
  229.      "\n\tDummy arg %ld dim%s size %ld in module %s line %u file %s",
  230.                 dims1,pluralize(dims1),
  231.                 size1,
  232.                 args1->module->name,
  233.                 args1->line_num,
  234.                 args1->filename);
  235.  fprintf(list_fd,
  236.     "\n\tActual arg %ld dim%s size %ld in module %s line %u file %s",
  237.                 dims2,pluralize(dims2),
  238.                 size2,
  239.                 args2->module->name,
  240.                 args2->line_num,
  241.                 args2->filename);
  242.  
  243.                 }
  244.             }
  245.             }
  246.             else {
  247.                     /*   C. Actual arg is scalar */
  248.                     /*    Warn in all cases */
  249.  
  250.                 /* stop after limit: probably a cascade */
  251.                 if(++arrayness_errs > CMP_ERR_LIMIT) {
  252.                       fprintf(list_fd,"\n etc...");
  253.                       break;
  254.                 }
  255.  
  256.                 if(arrayness_errs == 1)
  257.  fprintf(list_fd,"\nSubprogram %s:  argument arrayness mismatch",
  258.                  name);
  259.  
  260.  fprintf(list_fd, "\n  at position %d:", i+1);
  261.  
  262.  fprintf(list_fd,
  263.     "\n\tDummy arg is array in module %s line %u file %s",
  264.                 args1->module->name,
  265.                 args1->line_num,
  266.                 args1->filename);
  267.  fprintf(list_fd,
  268.     "\n\tActual arg is scalar in module %s line %u file %s",
  269.                 args2->module->name,
  270.                 args2->line_num,
  271.                 args2->filename);